A simple model for the estimation of the maximum percentage of deaths due to COVID-19
============================================================================
NOTE:
============================================================================
The prediction based on a simple logistic model and:
70% of SARS-CoV-2 exposure
10% Infection efficacy i.e. 10% of the exposure subjects turns into a Covid-19 case
1% of Mortality
For each country we will use the urban population
I will estimate the death rates based on current trends fitted to the logistic function.
The last 14 days will be used for the peak estimations. Peak estimations will be done using:
If the data has not reached the peak the plots will show estimations based on:
If the data reached the peak the plots will show:
The flattening of the curve will be plotted as a grey line. It represents the maximum expected number of deaths at that specified date. If the maximum number of deaths is going down future looks good!
The peaks locations as red diamonds. The estimated peaks are based on information from dates before the actual peak. You can use them to get an idea of how reliable the estimations were.
I am also providing optimistic models. I´m assuming that the # of fatalities are 20% of the total expected.
Notes:
https://github.com/joseTamezPena/COVID_Forecasting
# The expetec % of deaths in each country
expectedtotalFatalities = 0.7*0.1*0.01
optGain <- 3
# The number of observations used for the trends
daysWindow <- 14
today <- Sys.Date()
currentdate <- paste(as.character(today),":")
The data is the time_covid19ing set from CSSE at Johns Hopkins University:
Ploting some trends
Country.Region <- rownames(time_covid19Country)
totaldeaths <- as.numeric(time_covid19Country[,ncol(time_covid19Country)])
names(totaldeaths) <- Country.Region
totaldeaths <- totaldeaths[order(-totaldeaths)]
ydata <- as.numeric(time_covid19Country[names(totaldeaths[1]),])
ydata <- ydata[ydata > 1e-6]
plot(ydata,main="# Fatalities",xlab="Days",ylab="Fatalities",xlim=c(1,ncol(time_covid19Country)))
text(length(ydata)-1,ydata[length(ydata)],names(totaldeaths[1]))
for (ctr in names(totaldeaths[1:30]))
{
ydata <- as.numeric(time_covid19Country[ctr,])
ydata <- ydata[ydata > 1e-6]
lines(ydata)
text(length(ydata)-1,ydata[length(ydata)],ctr)
}
totaldeaths <- totaldeaths[!is.na(totaldeaths)]
totaldeaths <- totaldeaths[totaldeaths > 100]